(ns rete.environment
  (:require [rete.core :refer :all])
  (:require [clojure.set :refer :all :as set])
  (:import [rete.core Environment Graph WME]))

;; Graph specific functions

(defn create-new-graph []
  "(create-new-graph) creates a new empty graph."
  (Graph. #{} {} #{} {}))

(defn- add-mutablenode[^Graph g node]
  (if (not-empty (get node :depending-objects #{}))
    (reduce #(update-in %1 [:mutablenodes %2] conj (:name node)) g (:depending-objects node))
    g))

(defn- add-implicationnode [^Graph g node]
  (if (= implication-node (:type node)) 
    (update-in g [:actions] conj (:name node))
    g))  

(extend-type Graph GraphProtocol
  (get-node [^Graph g node-name]
    (if (contains? (:nodes g) node-name)
      (get (:nodes g) node-name) 
      (throw (IllegalStateException. (clojure.string/join (list "Node with the name '" node-name "' does not exsist." ))))))
  
  (get-nodes [^Graph g node-names]
    {:pre [(coll? node-names)]}
    (vals (select-keys (:nodes g) node-names)))
  
  (rootnode? [^Graph g node-name]
    (contains? (:rootnodes g) node-name))
  
  (get-children-for-node [^Graph graph node-name ]
    (:children (get-node graph node-name)))
  
  (get-children-for-nodes  [^Graph graph node-names]
    {:pre [(coll? node-names)]}
    (reduce #(set/union %1 (:children (get-node graph %2))) #{} node-names))
  
  (get-parents-for-node  [^Graph graph node-name ]
    (:parents (get-node graph node-name)))
  
  (get-parents-for-nodes  [^Graph graph node-names ]
    {:pre [(coll? node-names)]}
    (map #(:parents (get-node graph %1)) node-names))
  
  (add-child-to-parent  [^Graph g child-name parent-name]
    {:pre [(not= child-name parent-name)]}
    (update-in   
      (update-in g [:nodes] assoc 
                 parent-name (add-child (get-node g parent-name) child-name)
                 child-name (add-parent (get-node g child-name) parent-name)) 
      [:rootnodes] disj child-name))
  
  (add-parent-to-child  [^Graph g parent-name child-name]
    (add-child-to-parent g child-name parent-name))
  
  (remove-child-from-parent  [^Graph g child-name parent-name]
    {:pre [(not= child-name parent-name)]}
    (let[new-graph (update-in g [:nodes] assoc 
                              parent-name (remove-child (get-node g parent-name) child-name)
                              child-name (remove-parent (get-node g child-name) parent-name))]
      (if(empty? (get-children-for-node parent-name new-graph)) 
        (update-in new-graph [:rootnodes] conj parent-name)
        new-graph)))
  
  (add-parents-to-child [^Graph g parent-names child-name]
    {:pre [(coll? parent-names) (not (contains? parent-names child-name))]}
    (reduce #(add-child-to-parent %1 child-name %2) g parent-names))
  
  (add-children-to-parent  [^Graph g children-names parent-name]
    {:pre [(coll? children-names) (not (contains? children-names parent-name))]}
    (reduce #(add-child-to-parent %1 %2 parent-name) g children-names))
  
  (remove-children-from-parent  [^Graph g children-names parent-name]
    {:pre [(coll? children-names) (not (contains? children-names parent-name))]}
    (reduce #(remove-child-from-parent %1 %2 parent-name) g children-names))
  
  (remove-parents-from-child  [^Graph g parent-names child-name]
    {:pre [(coll? parent-names) (not (contains? parent-names child-name))]}
    (reduce #(remove-child-from-parent %1 child-name %2 ) g parent-names))
  
  (add-root-node [^Graph g node]
    (let [new-graph (update-in (update-in 
                                 g [:rootnodes] conj(:name node))
                               [:nodes] assoc (:name node) node)]
      (add-implicationnode  
        (add-mutablenode new-graph node) 
        node)))
  
  (add-node 
    ([^Graph g parent-name node]
      (let[new-graph (add-child-to-parent (update-in g [:nodes] assoc (:name node) node)
                                          (:name node) 
                                          parent-name)]
        (add-implicationnode  
          (add-mutablenode new-graph node) 
          node)))
    ([^Graph g node] (add-root-node g node)))
  
  (remove-node  [^Graph g node-name] 
    (let[original-node (get-node g node-name)]
      (update-in (remove-children-from-parent 
                   (remove-parents-from-child g (:parents original-node) node-name)
                                 (:children original-node) node-name)
                 [:nodes] dissoc node-name)))
  )

;; Environment specific functions
(extend-type Environment EnvironmentProtocol
  (get-objects [^Environment this objects] 
    (reduce #(conj %1 (:object %2)) #{} (vals (select-keys (:working-memory this) objects)))))

(defn create-new-environment 
  ([]
    "(create-new-environment) creates a new enviornment with empty working memory and empty graph."
    (Environment. {} (create-new-graph)))
  ([^Graph g]
    "(create-new-environment g) creates a new enviornment with empty working memory and the passed grapg 'g'."
    (Environment. {} g)))

(defn modify-node-info-for-object
  [nodes object ^Environment env]
  (update-in env [:working-memory (hash object) :nodes] merge nodes))

(defn add-object-to-nodes 
  "(add-object-to-nodes nodes object env) adds the passed object to the collection of fulfilled object to the given environment for the specified nodes."
  [node-names object ^Environment env]
  (reduce #(add-object (get-node (:graph env) %2) object %1) env node-names))

(defn remove-object-from-nodes 
  "(remove-object-from-nodes object node-names env) removes the passed object from the specified collection of nodes."
  [object node-names ^Environment env]
  {:pre [(coll? node-names)]}
  (reduce #(remove-object %2 object %1) env (get-nodes (:graph env) node-names)))

(defn remove-object-from-node 
  [^Environment environment object node-name]
  (update-in (update-in environment [:working-memory (hash object) :nodes] disj node-name)
             [:graph :nodes node-name :complied-objects] disj (hash object)))

(defn remove-objects-from-node 
  [^Environment environment objects node-name]
  (reduce #(remove-object-from-node %1 %2 node-name) environment objects))

(defn- update-complied-objects-in-node [^Environment environment objects node-name]
  (reduce (fn[^Environment env object] (add-object-to-nodes #{node-name} object env)) 
          (remove-objects-from-node environment objects node-name) 
          (filter #(>= threshold  (get-node (:graph environment) node-name )%1 environment) objects)))

(defn get-complied-nodes-for
  "(get-complied-nodes-for object env node-names) returns all names of the passed 'node-names' where their predicates returns 
a truth-value which is more or equal the defined threshold for the specified object in the given environment."
  [object ^Environment env node-names]
  {:pre [(coll? node-names)]}
  (filter #(<= threshold (truth-value?
                           (get-node (:graph env) %1) 
                           object env))
               node-names))

(defn get-complied-objects-for-nodes [^Environment env node-names]
  (get-objects env 
               (reduce #(clojure.set/union %1 (keys (:complied-objects %2))) 
                       #{} 
                       (get-nodes (:graph env) node-names))))

(defn add-object-into-environment 
  "(add-object-into-environment environment object) adds new object to the environment and any condition it will fulfill. 
To ensure the correct distinction of the objects in the environment only maps are allowed as objects.
Note: Neither add-object-into-environment nor remove-object-from-environment will change the pedicates of nodes which have a dependency to the modified object. 
Use replace-object-in-environment instead." 
  [^Environment environment object]
  {:pre [(map? object)]}
  (reduce #(add-object %2 object %1) 
          (update-in environment [:working-memory] assoc (hash object) (WME. object {})) 
          (get-nodes (:graph environment) (:rootnodes (:graph environment)))))
  
(defn remove-object-from-environment 
  "(remove-object-from-environment environment object) removes the object from the environment and any condition it will fulfill. 
To ensure the correct distinction of the objects in the environment only maps are allowed as objects.
Note: Neither add-object-into-environment nor remove-object-from-environment will change the pedicates of nodes which have a dependency to the modified object. 
Use replace-object-in-environment instead." 
  [^Environment environment object]
  {:pre [(map? object)]}
  (update-in ( remove-object-from-nodes object
                                        (:nodes (get (:working-memory environment) (hash object) (WME. nil #{})))
                                        environment)
             [:working-memory] dissoc (hash object)))

(defn get-complied-actions 
  "(get-complied-actions env) returns all actions in the specified environment 'env' which have at least one complied object.
(get-complied-actions env sort-fn) returns all actions in the specified environment 'env' which have at least one complied object in the order specified by the passed sorting function 'sort-fn'."
  ([^Environment env]
    (filter #(not-empty (:complied-objects %1)) (get-nodes (:graph env) (:actions (:graph env)))))
  ([^Environment env sort-fn]
    {:pre [(fn? sort-fn)]}
    (sort sort-fn (get-complied-actions env))))

(defn replace-object-in-environment [^Environment env old-object new-object]
  "(replace-object-in-environment env old-object new-object) replaces the the given old object with the specified new object in the given environment. Unlike add-object-to-environment will this function also update any nodes where the predicates have a dependency to the old object."
  (let [considered-nodes (get (get (:graph env) :mutablenodes {}) (hash old-object) #{})]
    (add-object-into-environment (remove-object-from-environment env old-object) 
                                 new-object)))